home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / crtplus.zip / CRTPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-05  |  15KB  |  547 lines
  1. {
  2.  
  3.     CrtPlus.pas
  4.     1-5-90
  5.  
  6.     Keyboard, cursor, and window enhancements to
  7.     Turbo Pascal 5.5's Crt unit.
  8.  
  9.     Copyright 1990
  10.     John W. Small
  11.     All rights reserved
  12.  
  13.     PSW / Power SoftWare
  14.     P.O. Box 10072
  15.     McLean, Virginia 22102 8072
  16.  
  17.     If you acquired the CrtPlus ToolBox through 'shareware'
  18.     and find it useful, a registration fee of $20 would
  19.     be appreciated.  Upon registion you will be sent source
  20.     code, manual on disk, the latest example programs, and
  21.     notices of updates.
  22.  
  23.  
  24.     Works consulted:
  25.  
  26.     Norton, Peter. "Program's Guide to the IBM PC."
  27.             Bellevue, Washington: Microsoft Press, 1985.
  28.  
  29.     Duncan, Ray. "Advanced MS DOS.", Bellevue Washington:
  30.             Microsoft Press, 1986.
  31.  
  32.     Wilton, Richard. "Programmer's Guide to PC & PS/2
  33.             Video Systems.", Bellevue Washington:
  34.             Microsoft Press, 1987.
  35.  
  36. }
  37.  
  38. unit CrtPlus;
  39.  
  40. interface
  41.  
  42.     uses dos, crt;
  43.  
  44.     const
  45.  
  46.         {
  47.             Ascii codes returned by CrtPlus.ReadKey, and
  48.             Crt.ReadKey (first call).
  49.         }
  50.  
  51.         ESC         =   #27;
  52.         CR          =   #13;
  53.         Tab         =    #9;
  54.         BackSp      =    #8;
  55.         Space       =   #32;
  56.         DelCh       =  #127;
  57.  
  58.         CtrlA       =    #1;
  59.         CtrlB       =    #2;
  60.         CtrlC       =    #3;
  61.         CtrlD       =    #4;
  62.         CtrlE       =    #5;
  63.         CtrlF       =    #6;
  64.         CtrlG       =    #7;
  65.         CtrlH       =    #8;
  66.         CtrlI       =    #9;
  67.         CtrlJ       =   #10;
  68.         CtrlK       =   #11;
  69.         CtrlL       =   #12;
  70.         CtrlM       =   #13;
  71.         CtrlN       =   #14;
  72.         CtrlO       =   #15;
  73.         CtrlP       =   #16;
  74.         CtrlQ       =   #17;
  75.         CtrlR       =   #18;
  76.         CtrlS       =   #19;
  77.         CtrlT       =   #20;
  78.         CtrlU       =   #21;
  79.         CtrlV       =   #22;
  80.         CtrlW       =   #23;
  81.         CtrlX       =   #24;
  82.         CtrlY       =   #25;
  83.         CtrlZ       =   #26;
  84.  
  85.  
  86.         {
  87.             Scan codes returned when (CrtPlus.ReadKey = #0)
  88.             via the global variable, CrtPlus.scan,
  89.             or by Crt.ReadKey (second call). Please note
  90.             that CrtPlus.ReadKey requires only one call
  91.             since the extended character set characters are
  92.             returned in CrtPlus.scan.  CrtPlus.ReadKey is
  93.             faster than Crt.ReadKey since it is inline code
  94.             which also explains why I couldn't make the
  95.             keyboard into an object.
  96.         }
  97.  
  98.         AltA        =    #30;
  99.         AltB        =    #48;
  100.         AltC        =    #46;
  101.         AltD        =    #32;
  102.         AltE        =    #18;
  103.         AltF        =    #33;
  104.         AltG        =    #34;
  105.         AltH        =    #35;
  106.         AltI        =    #23;
  107.         AltJ        =    #36;
  108.         AltK        =    #37;
  109.         AltL        =    #38;
  110.         AltM        =    #50;
  111.         AltN        =    #49;
  112.         AltO        =    #24;
  113.         AltP        =    #25;
  114.         AltQ        =    #16;
  115.         AltR        =    #19;
  116.         AltS        =    #31;
  117.         AltT        =    #20;
  118.         AltU        =    #22;
  119.         AltV        =    #47;
  120.         AltW        =    #17;
  121.         AltX        =    #45;
  122.         AltY        =    #21;
  123.         AltZ        =    #44;
  124.  
  125.         Home        =    #71;
  126.         UpArr       =    #72;
  127.         PgUp        =    #73;
  128.         LArr        =    #75;
  129.         RArr        =    #77;
  130.         EndKey      =    #79;
  131.         DnArr       =    #80;
  132.         PgDn        =    #81;
  133.         InsKey      =    #82;
  134.         DelKey      =    #83;
  135.  
  136.         CtrlHome    =    #119;
  137.         CtrlPgUp    =    #132;
  138.         CtrlLArr    =    #115;
  139.         CtrlRArr    =    #116;
  140.         CtrlEnd     =    #117;
  141.         CtrlPgDn    =    #118;
  142.  
  143.  
  144.         Alt1        =    #120;
  145.         Alt2        =    #121;
  146.         Alt3        =    #122;
  147.         Alt4        =    #123;
  148.         Alt5        =    #124;
  149.         Alt6        =    #125;
  150.         Alt7        =    #126;
  151.         Alt8        =    #127;
  152.         Alt9        =    #128;
  153.         Alt0        =    #129;
  154.  
  155.         AltHyphen   =    #130;
  156.         AltEquals   =    #131;
  157.         CtrlPrtSc   =    #114;
  158.         ShiftTab    =     #15;
  159.  
  160.  
  161.         F1          =     #59;
  162.         ShiftF1     =     #84;
  163.         CtrlF1      =     #94;
  164.         AltF1       =    #104;
  165.  
  166.         F2          =     #60;
  167.         ShiftF2     =     #85;
  168.         CtrlF2      =     #95;
  169.         AltF2       =    #105;
  170.  
  171.         F3          =     #61;
  172.         ShiftF3     =     #86;
  173.         CtrlF3      =     #96;
  174.         AltF3       =    #106;
  175.  
  176.  
  177.         F4          =     #62;
  178.         ShiftF4     =     #87;
  179.         CtrlF4      =     #97;
  180.         AltF4       =    #107;
  181.  
  182.         F5          =     #63;
  183.         ShiftF5     =     #88;
  184.         CtrlF5      =     #98;
  185.         AltF5       =    #108;
  186.  
  187.         F6          =     #64;
  188.         ShiftF6     =     #89;
  189.         CtrlF6      =     #99;
  190.         AltF6       =    #109;
  191.  
  192.         F7          =     #65;
  193.         ShiftF7     =     #90;
  194.         CtrlF7      =    #100;
  195.         AltF7       =    #110;
  196.  
  197.         F8          =     #66;
  198.         ShiftF8     =     #91;
  199.         CtrlF8      =    #101;
  200.         AltF8       =    #111;
  201.  
  202.         F9          =     #67;
  203.         ShiftF9     =     #92;
  204.         CtrlF9      =    #102;
  205.         AltF9       =    #112;
  206.  
  207.         F10         =     #68;
  208.         ShiftF10    =     #93;
  209.         CtrlF10     =    #103;
  210.         AltF10      =    #113;
  211.  
  212.         {  some BIOS' don't return these  }
  213.  
  214.         F11         =    #133;
  215.         ShiftF11    =    #135;
  216.         CtrlF11     =    #137;
  217.         AltF11      =    #139;
  218.  
  219.         F12         =    #134;
  220.         ShiftF12    =    #136;
  221.         CtrlF12     =    #138;
  222.         AltF12      =    #140;
  223.  
  224.  
  225.         {
  226.             BIOS keyboard shift constants used to mask value
  227.             returned by CrtPlus.ReadShift, e.g.
  228.  
  229.                 if CapsLock and ReadShift then ...
  230.         }
  231.  
  232.         InsertState         =   128;
  233.         CapsLock            =    64;
  234.         NumLock             =    32;
  235.         ScrollLock          =    16;
  236.         AltPressed          =     8;
  237.         CtrlPressed         =     4;
  238.         LeftShiftPressed    =     2;
  239.         RightShiftPressed   =     1;
  240.         ShiftPressed        =     3;
  241.  
  242.     type
  243.  
  244.         {
  245.             TextFrameChars are the IBM extended character
  246.             set characters used to draw line boxes.  Imagine
  247.             a box with a cross inside, then the characters
  248.             needed to draw this are typified by the corners
  249.             of the box, the four points the cross touches
  250.             the outside box, and the center of the cross.
  251.  
  252.             Indices into textFrameChars are thus:
  253.  
  254.                 rt = top-right corner of the box,
  255.                 mm = middle-middle or center of cross,
  256.                 mb = middle-bottom where cross touches
  257.                         the bottom of the box
  258.                 etc.
  259.         }
  260.  
  261.         textFrameChars = (v,h,lt,rt,rb,lb,ml,mt,mr,mb,mm);
  262.  
  263.         textFrame = array[textFrameChars] of char;
  264.  
  265.     const
  266.  
  267.         {
  268.             Text Box Drawing Characters:
  269.  
  270.                 svsh = single vert., single horizonal lines
  271.                 dvdh = double vert., double horizonal lines
  272.                 etc.
  273.         }
  274.  
  275.         svsh : textFrame =
  276.             #179#196#218#191#217#192#195#194#180#193#197;
  277.         svdh : textFrame =
  278.             #179#205#213#184#190#212#198#209#181#207#216;
  279.         dvsh : textFrame =
  280.             #186#196#214#183#189#211#199#210#182#208#215;
  281.         dvdh : textFrame =
  282.             #186#205#201#187#188#200#204#203#185#202#206;
  283.  
  284.     type
  285.  
  286.  
  287.         { Cursor object for turning on/off cursor, etc. }
  288.  
  289.         CursorShape = object                { CURSORSHAPE }
  290.             OrigShape, prevShape : word;
  291.             procedure init;     { Do not call! }
  292.             function  getShape : word;
  293.             procedure putShape (shape : word);
  294.             function  defaultShape : word;
  295.             procedure off;
  296.             procedure on;
  297.             procedure block;
  298.             procedure normal;
  299.             procedure restore;
  300.             procedure done;
  301.         end;
  302.  
  303.  
  304.  
  305.         { Object for storing text screen images. }
  306.  
  307.         TextImage = object                    { TEXTIMAGE }
  308.             ImageMin, ImageMax : word;
  309.             image : ^word;
  310.             procedure init (x1, y1, x2, y2 : byte);
  311.             procedure done
  312.         end;
  313.  
  314.  
  315.  
  316.         {
  317.             Turbo Pascal's text-screen state, i.e. current
  318.             window, text attribute, cursor position, and
  319.             cursor shape.
  320.         }
  321.  
  322.         TurboWindow = object                { TURBOWINDOW }
  323.             WindMin, WindMax : word;
  324.             textAttr, wherex, wherey : byte;
  325.             curshape : word;
  326.             procedure save;
  327.             procedure restore;
  328.         end;
  329.  
  330.  
  331.  
  332.         {
  333.             TextWindow is a direct replacement for Turbo
  334.             Pascal's window procedure.  It sets the current
  335.             window, like Turbo Pascal does, but it also
  336.             saves the shadow beneath the window and the
  337.             screen state before the window was called.  When
  338.             done is called the window is removed and the
  339.             screen returned to its previous state.  Call
  340.             TxtScr.TextMode() instead of Crt.TextMode()
  341.             when changing video modes to insure proper
  342.             operation!
  343.         }
  344.  
  345.         TextWindow = object                    { TEXTWINDOW }
  346.             shadow : TextImage;
  347.             prevWind  : TurboWindow;
  348.             procedure window (x1, y1, x2, y2 : byte);
  349.             procedure done
  350.         end;
  351.  
  352.  
  353.  
  354.         {
  355.             The TextScreen object provides enhancements to
  356.             Turbo Pascal's Crt unit's treatment of the text
  357.             screen.  The TextScreen object works in all the
  358.             text modes supported by Turbo Pascal including
  359.             43/50 line modes!  It also respects the setting
  360.             of Crt.CheckSnow and Crt.DirectVideo!  The only
  361.             restriction is that your call TxtScr.TextMode()
  362.             instead of Crt.TextMode() when changing video
  363.             modes.
  364.         }
  365.  
  366.         TextScreen = object                    { TEXTSCREEN }
  367.  
  368.             OrigMode, dim, vseg, vport : word;
  369.             prevTextAttr : byte;
  370.             state : TextWindow;    { used by save and restore }
  371.             CheckSnow, DirectVideo : boolean;
  372.             vmode : integer;
  373.  
  374.             procedure init;     { Do not call! }
  375.  
  376.  
  377.             { Use to save screen during exec calls. }
  378.  
  379.             procedure save;
  380.             procedure restore;
  381.  
  382.  
  383.             { Use instead of Crt.TextMode(). }
  384.  
  385.             procedure TextMode  (mode : integer);
  386.             function  VideoMode : integer;
  387.             function  IsTextMode : boolean;
  388.             function  IsColorMode : boolean;
  389.  
  390.  
  391.             { Use to extend Low/Norm/High video. }
  392.  
  393.             procedure ReverseVideo;
  394.             procedure SetVideo  (fgrd, bgrd : byte);
  395.             procedure BlinkVideo;
  396.             procedure UnblinkVideo;
  397.             procedure RestoreVideo;
  398.  
  399.  
  400.             { Use to construct TextAttr bytes. }
  401.  
  402.             function  rvideo (attr : byte) : byte;
  403.             function  svideo (fgrd, bgrd : byte) : byte;
  404.             function  bvideo (attr : byte) : byte;
  405.             function  ubvideo (attr : byte) : byte;
  406.             function  lvideo (attr : byte) : byte;
  407.             function  hvideo (attr : byte) : byte;
  408.  
  409.  
  410.             { Use to save and restore screen images. }
  411.  
  412.             procedure getText   (var ti : TextImage);
  413.             procedure putText   (var ti : TextImage);
  414.  
  415.  
  416.             {
  417.                 Use instead of WhereX and WhereY for
  418.                 screen coordinates.
  419.             }
  420.  
  421.             function  scrX : byte;
  422.             function  scrY : byte;
  423.  
  424.  
  425.             { Use to write to screen without scroll/wrap. }
  426.  
  427.             procedure scrWrite  (
  428.                 x, y, maxLen, attr : byte;
  429.                 var str : string);
  430.             procedure scrFill   (    
  431.                 x, y, len, attr : byte; ch : char);
  432.                 { Note: if ch = #0 then fill attr only }
  433.             procedure scrHorzLn (
  434.                 left, row, right, attr: byte; ch: char);
  435.             procedure scrVertLn (
  436.                 col, top, bottom, attr: byte; ch: char);
  437.             procedure scrBox    (
  438.                 x1, y1, x2, y2, attr: byte;
  439.                 var tf : textFrame);
  440.  
  441.  
  442.             {
  443.                 Use to write to current crt.window without
  444.                 scroll/wrap
  445.             }
  446.  
  447.             procedure windWrite (var str : string);
  448.             procedure windLightBar (x, y, len, attr : byte);
  449.             procedure windColor (fgrd, bgrd : byte);
  450.  
  451.  
  452.             {  Call to restore original crt mode. }
  453.  
  454.             procedure done
  455.         end;
  456.  
  457.  
  458.  
  459.         {
  460.             FramedTextWindow is a popup window object drived
  461.             from the TextWindow object.  This window has an
  462.             optional border, title and/or footer, and scroll
  463.             bar(s).  This object provides an example of how
  464.             the TextWindow object is extensible and can be
  465.             used as a base class object to construct any
  466.             type of text window!  Call TxtScr.TextMode()
  467.             instead of Crt.TextMode() when changing video
  468.             modes to insure proper operation!
  469.         }
  470.  
  471.                                     { FRAMEDTEXTWINDOW }
  472.  
  473.         FramedTextWindow = object(TextWindow)
  474.             procedure window (x1, y1, x2, y2 : byte);
  475.             procedure frame  (
  476.                 attr : byte; var f : textFrame);
  477.             procedure titleFooter (
  478.                 title : boolean; attr : byte; str : string);
  479.             procedure scrollBar (
  480.                 vert : boolean; attr : byte;
  481.                 var f : textFrame; p, maxp : integer);
  482.             { Uses procedure TextWindow.done; }
  483.         end;
  484.  
  485.  
  486.  
  487.         {
  488.             ShadowTextWindow is yet another popup window
  489.             object drived from the TextWindow object.  This
  490.             window has an title bar and shadow beneath the
  491.             window.  This object is yet another extension to
  492.             the TextWindow object.  Call TxtScr.TextMode()
  493.             instead of Crt.TextMode() when changing video
  494.             modes to insure proper operation!
  495.         }
  496.  
  497.                                     { SHADOWWINDOW }
  498.  
  499.         ShadowTextWindow = object(TextWindow)
  500.             procedure window(x1, y1, x2, y2 : byte);
  501.             procedure title(attr : byte; str : string);
  502.             { Uses procedure TextWindow.done; }
  503.         end;
  504.  
  505.  
  506.     var
  507.  
  508.         cursor : CursorShape;    { TEXT CURSOR OBJECT }
  509.  
  510.         TxtScr : TextScreen;    { TEXT SCREEN OBJECT }
  511.  
  512.         scan : char;    { KEYBOARD SCAN CODE }
  513.                         { set by CrtPlus.ReadKey }
  514.  
  515.  
  516.     { READ CHARACTER FROM KEYBOARD }
  517.  
  518.     function  ReadKey : char;
  519.                 inline($30/$E4/             { xor ah,ah }
  520.                     $CD/$16/                { int $16   }
  521.                     $88/$26/CrtPlus.scan/   { mov scan,ah }
  522.                     $30/$E4);               { xor ah,ah }
  523.  
  524.  
  525.     { IS CHARACTER WAITING? }
  526.  
  527.     function  KeyPressed : boolean;
  528.                 inline($B4/$01/         { mov ah,1  }
  529.                     $CD/$16/            { int $16   }
  530.                     $9C/                { pushf     }
  531.                     $58/                { pop ax    }
  532.                     $25/>$01);          { and ax,1  }
  533.  
  534.  
  535.     { FLUSH KEYBOARD BUFFER }
  536.  
  537.     procedure ClrKey;
  538.  
  539.  
  540.     { READ KEYBOARD SHIFT STATE }
  541.  
  542.     function  ReadShift : byte;
  543.                 inline($B4/$02/         { mov ah,2  }
  544.                     $CD/$16/            { int $16   }
  545.                     $30/$E4);           { xor ah,ah }
  546.  
  547.